SUBROUTINE Convert &
!
(input, output)
IMPLICIT NONE
! Arguments with intent (in):
TYPE (Coordinate), INTENT(IN) :: input
! Arguments with intent(inout):
TYPE (Coordinate), INTENT(INOUT) :: output
! Local variables:
REAL (KIND = float) :: geoLat, geoLon
REAL (KIND = float) :: latOut, lonOut
REAL (KIND = float) :: WGS84lat, WGS84lon
!------------end of declaration------------------------------------------------
! First coordinate conversion stage, convert to Geodetic
SELECT CASE (input % system % system )
CASE (TM)
CALL ConvertTransverseMercatorToGeodetic ( &
input % easting, &
input % northing, &
input % system % param (TM_scale_factor), &
input % system % param (TM_centM), &
input % system % param (TM_lat0), &
input % system % ellipsoid % a, &
input % system % ellipsoid % e, &
input % system % ellipsoid % e_second, &
input % system % param (TM_false_northing), &
input % system % param (TM_false_easting), &
geoLon, geoLat)
CASE (UTM)
CALL ConvertUTMtoGeodetic ( &
input % easting, &
input % northing, &
input % system % param (UTM_scale_factor), &
input % system % param (UTM_centM), &
input % system % param (UTM_lat0), &
input % system % ellipsoid % a, &
input % system % ellipsoid % e, &
input % system % ellipsoid % e_second, &
input % system % param (UTM_false_northing), &
input % system % param (UTM_false_easting), &
input % system % param (UTM_override), &
geoLon, geoLat)
CASE (GAUSS_BOAGA)
CALL ConvertGaussBoagaToGeodetic ( &
input % easting, &
input % northing, &
input % system % param (GB_scale_factor), &
input % system % param (GB_centM), &
input % system % param (GB_lat0), &
input % system % ellipsoid % a, &
input % system % ellipsoid % e, &
input % system % ellipsoid % e_second, &
input % system % param (GB_false_northing), &
input % system % param (GB_false_easting), &
geoLon, geoLat)
CASE (HOM)
CALL ConvertHotineToGeodetic ( &
input % easting, &
input % northing, &
input % system % param (HOM_scale_factor), &
input % system % param (HOM_centM), &
input % system % param (HOM_lat0), &
input % system % param (HOM_azimuth), &
input % system % ellipsoid % a, &
input % system % ellipsoid % e, &
input % system % param (HOM_false_northing), &
input % system % param (HOM_false_easting), &
geoLon, geoLat)
CASE (SOC)
CALL ConvertSwissToGeodetic ( &
input % easting, &
input % northing, &
input % system % param (SOC_scale_factor), &
input % system % param (SOC_lonc), &
input % system % param (SOC_latc), &
input % system % param (SOC_azimuth), &
input % system % ellipsoid % a, &
input % system % ellipsoid % e, &
input % system % param (SOC_false_northing), &
input % system % param (SOC_false_easting), &
geoLon, geoLat)
CASE (GEODETIC)
geolon = input % easting * degToRad !input is in deg
geolat = input % northing * degToRad
CASE DEFAULT
CALL Catch ('error', 'GeoLib', &
'reference system not supported: ', &
code = unknownOption, argument=input % system % name )
END SELECT
! Datum Transformation Stage
! Shift to WGS84, apply geoid correction, shift to output datum
IF ( input % system % datum % code /= WGS84 ) THEN
CALL GeodeticShiftToWGS84 (input, geoLat, geoLon, WGS84lat, WGS84lon) !OK
geoLat = WGS84lat
geoLon = WGS84lon
END IF
IF ( output % system % datum % code /= WGS84 ) THEN
CALL GeodeticShiftFromWGS84 (output, geoLat, geoLon, latOut, lonOut)
geoLat = latOut
geoLon = lonOut
END IF
! Second coordinate conversion stage, convert from Geodetic
SELECT CASE (output % system % system)
CASE (TM)
CALL ConvertGeodeticToTransverseMercator ( &
geoLon, &
geoLat, &
output % system % param (TM_scale_factor), &
output % system % param (TM_centM), &
output % system % param (TM_lat0), &
output % system % ellipsoid % a, &
output % system % ellipsoid % e, &
output % system % ellipsoid % e_second, &
output % system % param (TM_false_northing), &
output % system % param (TM_false_easting), &
output % easting, &
output % northing )
CASE (UTM)
CALL ConvertGeodeticToUTM ( &
geoLon, &
geoLat, &
output % system % param (UTM_scale_factor), &
output % system % param (UTM_centM), &
output % system % param (UTM_lat0), &
output % system % ellipsoid % a, &
output % system % ellipsoid % e, &
output % system % ellipsoid % e_second, &
output % system % param (UTM_false_northing), &
output % system % param (UTM_false_easting), &
output % easting, &
output % northing, &
output % system % param (UTM_zone), &
output % system % param (UTM_hemisphere), &
output % system % param (UTM_override) )
CASE (GEODETIC)
output % northing = geoLat * radToDeg !convert to deg before returning value
output % easting = geoLon * radToDeg
CASE (GAUSS_BOAGA)
CALL ConvertGeodeticToGaussBoaga ( &
geoLon, &
geoLat, &
output % system % param (GB_scale_factor), &
output % system % param (GB_centM), &
output % system % param (GB_lat0), &
output % system % ellipsoid % a, &
output % system % ellipsoid % e, &
output % system % ellipsoid % e_second, &
output % system % param (GB_false_northing), &
output % system % param (GB_false_easting), &
output % easting, &
output % northing )
CASE (HOM)
CALL ConvertGeodeticToHotine ( &
geoLon, &
geoLat, &
output % system % param (HOM_scale_factor), &
output % system % param (HOM_centM), &
output % system % param (HOM_lat0), &
output % system % param (HOM_azimuth), &
output % system % ellipsoid % a, &
output % system % ellipsoid % e, &
output % system % param (HOM_false_northing), &
output % system % param (HOM_false_easting), &
output % easting, &
output % northing )
CASE (SOC)
CALL ConvertGeodeticToSwiss ( &
geoLon, &
geoLat, &
output % system % param (SOC_scale_factor), &
output % system % param (SOC_lonc), &
output % system % param (SOC_latc), &
output % system % param (SOC_azimuth), &
output % system % ellipsoid % a, &
output % system % ellipsoid % e, &
output % system % param (SOC_false_northing), &
output % system % param (SOC_false_easting), &
output % easting, &
output % northing )
CASE DEFAULT
CALL Catch ('error', 'GeoLib', &
'reference system not supported: ', &
code = unknownOption, argument=input % system % name )
END SELECT
END SUBROUTINE Convert